We downloaded data from Census.gov using the get_acs function, did some data wrangling and cleaning, wrote them as a csv file so that we can import them into RMarkdown

#code_folding: "hide" (hides the code but ppl can see the code if they want to)
knitr::opts_chunk$set(echo =  TRUE, warning = FALSE, message = FALSE) #doesn't show the messages or the warings, only code output, must be its in own code chunk to apply to all the subsequent ones

Basic summary statistics:

How many renters are there in each county? of which demographics?

Petersburg, Hopewell, Charlottesville and Richmond have the highest percentage of renters (overall). Below is a table of the dempographics of renters in each county.

Tenure_By_Race_Perc <- Tenure_By_Race %>% 
  mutate(Perc_rentersE = (RentersE/Total_OccupantsE), Perc_ownersE = (OwnersE/Total_OccupantsE)) %>% 
  group_by(County) %>% 
  summarize(Renters = median(Perc_rentersE, na.rm = TRUE), Owners = median(Perc_ownersE, na.rm = TRUE), White_Renters = median((White_rentersE/RentersE), na.rm = TRUE), White_Owners = median((White_ownersE/OwnersE), na.rm = TRUE), Black_Renters = median((Black_rentersE/RentersE), na.rm = TRUE), Black_Owners = median((Black_ownersE/OwnersE), na.rm = TRUE), NativeAm_Owners = median((NativeAm_ownersE/OwnersE), na.rm = TRUE), NativeAm_Renters = median((NativeAm_rentersE/RentersE), na.rm = TRUE),  Asian_Owners = median((Asian_ownersE/OwnersE), na.rm = TRUE), Asian_Renters = median((Asian_rentersE/RentersE), na.rm = TRUE), PacificIslander_Owners = median((PacificIslander_ownerE/OwnersE), na.rm = TRUE), PacificIslander_Renters = median((PacificIslander_renterE/RentersE), na.rm = TRUE), HispanicLatino_Owners = median((HispanicLatino_ownerE/OwnersE), na.rm = TRUE), HispanicLatino_Renters = median((HispanicLation_renterE/RentersE), na.rm = TRUE)) %>% 
  mutate(across(c(2:14), scales::percent)) %>% 
  arrange(desc(Renters)) %>% 
  select(1:3,4,6,9,11,13,15,5,7,8,10,12,14)


sketch = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'County'),
      th(colspan = 6, 'Renters'),
      th(colspan = 6, 'Owners')
    ),
    tr(
      lapply(c('White_Renters', 'Black_Renters', 'NativeAm_Renters', 'Asian_Renters', "PacificIslander_Renters", "HispanicLatino_Renters", 'White_Owners', 'Black_Owners', 'NativeAm_Owners', 'Asian_Owners', "PacificIslander_Owners", "HispanicLatino_Owners"), th)
    )
  )
))

DT_Tenure_By_Race <- Tenure_By_Race_Perc[,c(1,4:15)]

datatable(DT_Tenure_By_Race, 
          caption = htmltools::tags$caption(
            style = 'caption-side: bottom; text-align: center;',
            'Table 1: ', htmltools::em('Median Percentage of Renters and Owners in Each County (by Demographics)')),
          container = sketch, 
          rownames = FALSE, 
          extensions = 'Buttons', 
          options = list(dom='Bfrtip',
                         buttons=c('copy', 'csv', 'excel', 'print', 'pdf')
                         )
          )

We also graphed the racial composition of renters, comparing Charlottesville and Richmond.

Tenure_perc_by_race <- Tenure_By_Race %>% 
  mutate(Perc_WRenters = (White_rentersE/RentersE), Perc_WOwners = (White_ownersE/OwnersE), Perc_BRenters = (Black_rentersE/RentersE), Perc_BOwners = (Black_ownersE/OwnersE), Perc_NativeAmOwners = (NativeAm_ownersE/OwnersE), Perc_NativeAmRenters = (NativeAm_rentersE/RentersE),  Perc_AsianOwners = (Asian_ownersE/OwnersE), Perc_AsianRenters = (Asian_rentersE/RentersE), Perc_PacificIslanderOwner = (PacificIslander_ownerE/OwnersE), Perc_PacificIslanderRenter = (PacificIslander_renterE/RentersE), Perc_HispanicLatinoOwner = (HispanicLatino_ownerE/OwnersE), Perc_HispanicLationRenterE = (HispanicLation_renterE/RentersE)) %>%
  select(1:5, 48:59)

Tenure_perc_by_race <- Tenure_perc_by_race %>%
  pivot_longer(., cols = c(Perc_AsianOwners, Perc_WRenters, Perc_WOwners, Perc_BOwners, Perc_BRenters, Perc_NativeAmOwners, Perc_NativeAmRenters, Perc_AsianRenters, Perc_PacificIslanderOwner, Perc_PacificIslanderRenter, Perc_HispanicLatinoOwner, Perc_HispanicLationRenterE), names_to = "Variable", values_to = "Percentage (Estimated)") %>% 
  mutate(Race = case_when(
    str_detect(Variable, "Asian") ~ "Asian",
    str_detect(Variable, "B") ~ "Black",
    str_detect(Variable, "NativeAm") ~ "Native American",
    str_detect(Variable, "PacificIslander") ~ "Pacific Islander",
    str_detect(Variable, "Hispanic") ~ "Hispanic or Latino",
    str_detect(Variable, "WRenters") ~ "White",
    str_detect(Variable, "WOwners") ~ "White"
  ), 
  Variable = case_when(
    str_detect(Variable, "Owner") ~ "Owner",
    str_detect(Variable, "Renter") ~ "Renter"
  )) 


Tenure_perc_by_race <- rename(Tenure_perc_by_race, Tenure_Type = Variable)



Tenure_perc_by_race %>% 
  filter(Tenure_Type == "Renter" & Race %in% race ) %>% 
  ggplot(aes(x = Tenure_Type, y = `Percentage (Estimated)`, fill = Race)) +
  scale_fill_viridis_d() +
  geom_boxplot() + 
  facet_wrap(~Region) +
  labs(title = "Racial Composition of Renters in Charlottesville and Richmond, Virginia", x = "Tenure Type")

What is the average rent, income, and real estate taxes paid in each County?

Highest rent: Fluvanna, Chesterfield, Henrico and Albemarle Highest median real estate taxes: Albemare, Charlottesville, Richmond, and Chesterfeild

ACS_Housing_Data |>
  group_by(County) |>
  summarize(Median_rent = median(MedianRentE, na.rm = TRUE), Median_tax = median(MedianTaxesE, na.rm = TRUE), Median_income = median(MedianIncomeE, na.rm = TRUE))

## # A tibble: 11 × 4
##    County          Median_rent Median_tax Median_income
##    <chr>                 <dbl>      <dbl>         <dbl>
##  1 Albemarle             1323       2657         55964 
##  2 Charlottesville       1181       2622.        40104 
##  3 Chesterfield          1333       1935         60040 
##  4 Fluvanna              1419       1786         49581 
##  5 Greene                 974.      1636.        51240.
##  6 Henrico               1214       1923         53133 
##  7 Hopewell               910.      1104.        28625 
##  8 Louisa                 875       1432         46964 
##  9 Nelson                 918.      1357         44754 
## 10 Petersburg City        952       1067         34167 
## 11 Richmond City         1085       2148         37975

What is the average rent to tax ratio (measure of rent exploitation) in each county?

Highest Rent Tax Ratio: Petersburg City, Chesterfeild, and Nelson

Tenure_and_Housing_Data <- full_join(Tenure_perc_by_race, ACS_Housing_Data, by = "GEOID") %>%
  select(1,6:30)

ACS_Housing_Data$RentTaxRatio <- round(ACS_Housing_Data$RentTaxRatio, 3)

Tenure_and_Housing_Data %>% 
  filter(`Percentage (Estimated)` >= 0.5, Race == "Black", Tenure_Type == "Renter") %>% 
   group_by(County.y) %>% 
  summarize(Rent_Tax_RaTio_Black = median(RentTaxRatio, na.rm = TRUE))

## # A tibble: 6 × 2
##   County.y        Rent_Tax_RaTio_Black
##   <chr>                          <dbl>
## 1 Chesterfield                   0.754
## 2 Henrico                        0.791
## 3 Hopewell                       0.859
## 4 Nelson                         0.962
## 5 Petersburg City                0.790
## 6 Richmond City                  0.589

Here is a look at the rent to tax ratio (measure of rent exploitation) across both regions

counties <- c("Albemarle", "Charlottesville", "Fluvanna", "Greene", "Louisa", "Nelson", "Richmond city", "Henrico", "Chesterfield", "Hopewell", "Petersburg")
countytracts <- tracts(state = "VA", county = counties, year = 2020)

countytracts <- countytracts |>
  mutate(GEOID = as.numeric(countytracts$GEOID))

HousingDataSpatial <- full_join(ACS_Housing_Data, countytracts, by = "GEOID") |>
  sf::st_as_sf() |>
  mutate(INTPTLAT = as.numeric(countytracts$INTPTLAT), INTPTLON = as.numeric(countytracts$INTPTLON))|> 
   sf::st_transform(crs = '+proj=longlat +datum=WGS84') 


pal <-  colorNumeric("YlOrRd", HousingDataSpatial$RentTaxRatio, reverse = TRUE)

HousingDataSpatial %>% 
leaflet() %>% 
  addTiles() %>% 
  addPolygons(color = "black",
              fillColor = ~pal(RentTaxRatio),
              fillOpacity = 0.6,
              weight = 2,
              highlight = highlightOptions(
                weight = 3,
                fillOpacity = 0.9,
                bringToFront = T),
              popup = paste0("County: ", HousingDataSpatial$County, "<br>",
                             "Tract: ", HousingDataSpatial$NAMELSAD, "<br>",
                             "Rent to Tax Ratio: ", HousingDataSpatial$RentTaxRatio)) %>% 
  addLegend(pal = pal, 
            values = ~RentTaxRatio, 
            opacity = 0.7, 
            title = "Rent to Tax Ratio (2020)", 
            position = "bottomleft")

What is the average percent of rent of income in each county? Thus, which county is the most rent burdened?

Richmond, Charlottesville and Nelson are the most rent burdened counties, but no counties appear to be severly rent burdened (more than 50), on average.

ACS_Housing_Data %>% 
  group_by(County) %>% 
  summarize(Median_perc_rent_income = median(PercRentBurdenE, na.rm = TRUE)) %>% 
  arrange(desc(Median_perc_rent_income))

## # A tibble: 11 × 2
##    County          Median_perc_rent_income
##    <chr>                             <dbl>
##  1 Richmond City                      32.6
##  2 Charlottesville                    31.9
##  3 Hopewell                           31.4
##  4 Henrico                            28.6
##  5 Albemarle                          27.9
##  6 Petersburg City                    27.8
##  7 Chesterfield                       27.5
##  8 Greene                             27  
##  9 Louisa                             26.6
## 10 Nelson                             23.8
## 11 Fluvanna                           21.3

Here is a more detailed look at who’s rent burded and severely rent burdened in each County, with Richmond still being the most rent burdened.

ACS_Housing_Data <- ACS_Housing_Data %>% 
  mutate(Rent_Burdened = case_when(
    PercRentBurdenE >= 30 & PercRentBurdenE < 50  ~ "Yes",
    PercRentBurdenE >= 50 ~"Yes, Severely",
    TRUE ~ "No")
    ) 

Rent_Burden_stats <- ACS_Housing_Data %>% 
  filter(Rent_Burdened != "No") %>% 
  group_by(Rent_Burdened,  County) %>% 
  summarize(Percent = round((n()/317)*100, 3)) %>% 
  arrange(desc(Percent))

knitr::kable(Rent_Burden_stats)

Rent_Burdened	County	Percent
Yes	Richmond City	13.565
Yes	Henrico	10.095
Yes	Chesterfield	6.940
Yes	Albemarle	3.155
Yes	Charlottesville	2.208
Yes	Petersburg City	1.262
Yes, Severely	Richmond City	1.262
Yes	Hopewell	0.946
Yes	Louisa	0.946
Yes, Severely	Chesterfield	0.946
Yes, Severely	Albemarle	0.315
Yes, Severely	Fluvanna	0.315
Yes, Severely	Henrico	0.315
Yes, Severely	Nelson	0.315

As we can see here, although it may not look like it from the numbers above, a lot of counties (the biggest census tracts too) are rent burdened, some even severely.

pal1 <-  colorNumeric("YlOrRd", HousingDataSpatial$PercRentBurdenE, reverse = TRUE)

HousingDataSpatial %>% 
leaflet() %>% 
  addTiles() %>% 
  addPolygons(color = "black",
              fillColor = ~pal1(PercRentBurdenE),
              fillOpacity = 0.6,
              weight = 2,
              highlight = highlightOptions(
                weight = 3,
                fillOpacity = 0.9,
                bringToFront = T),
              popup = paste0("County: ", HousingDataSpatial$County, "<br>",
                             "Tract: ", HousingDataSpatial$NAMELSAD, "<br>",
                             "Percentage of Rent Burden: ", HousingDataSpatial$PercRentBurdenE)) %>% 
  addLegend(pal = pal1, 
            values = ~PercRentBurdenE, 
            opacity = 0.7, 
            title = "Percentage of Rent Burden (2020)", 
            position = "bottomleft")

What does the income and ratio look like there?

Although these three are the most rent burdened, it isn’t obvious based on its rent to tax ratio and median household income, except for in Nelson county (which only has 5 observations in the tract)

Richmond: Median Income is $53,216.5 and the Rent to Tax Ratio is 0.484
Charlottesville: Median Income is $62,477.5 and the Rent to Tax Ratio is 0.4325
Nelson: Median Income is $53,579 and the Rent to Tax Ratio is 0.71

Which county has the most students (includes Undergraduate and Graduate students)?

No one county has a disproportionate amount of students compared to the other, however, Richmond, Charlottesville, and Henrico have the highest student populations

 ACS_Housing_Data %>% 
  group_by(County) %>% 
  summarize(Median_perc_students = median(Perc_StudentsE, na.rm = TRUE))

## # A tibble: 11 × 2
##    County          Median_perc_students
##    <chr>                          <dbl>
##  1 Albemarle                       5.21
##  2 Charlottesville                 5.98
##  3 Chesterfield                    5.43
##  4 Fluvanna                        4.96
##  5 Greene                          3.16
##  6 Henrico                         5.59
##  7 Hopewell                        4.84
##  8 Louisa                          3.7 
##  9 Nelson                          4.96
## 10 Petersburg City                 4.8 
## 11 Richmond City                   6.59

*More than 50% of pop. in tracts in Richmond and Charlottesville city consist of students, but doesn’t seem like the case for Henrico!

perc_student_counties <- c("Richmond City", "Charlottesville", "Henrico")

Moststudents <- HousingDataSpatial %>% 
  filter(County %in% perc_student_counties)

pal2 <-  colorNumeric("YlOrRd", Moststudents$Perc_StudentsE, reverse = TRUE) #the reverse argument reverses the color palette 


Moststudents %>% 
  leaflet() %>% 
  addTiles() %>% 
  addPolygons(color = "black",
              fillColor = ~pal2(Perc_StudentsE),
              weight = 2,
              fillOpacity = 0.6,
              highlight = highlightOptions(
                weight = 3,
                fillOpacity = 0.9,
                bringToFront = T),
              popup = paste0("County: ", Moststudents$County, "<br>",
                             "Tract: ", Moststudents$NAMELSAD, "<br>",
                             "Percentage of Students: ", Moststudents$Perc_StudentsE)) %>%
  addLegend(pal = pal2, 
            values = ~Perc_StudentsE, 
            opacity = 0.7, 
            title = "Highest Percentage of Students in Charlottesville and Richmond regions for 2020", 
            position = "bottomleft")

Here’s a detailed look at which census tracts have the most students

HousingDataSpatial %>% 
  filter(Perc_StudentsE >= 50) %>% 
  select(3,22) %>% 
  arrange(desc(Perc_StudentsE))

## Simple feature collection with 8 features and 2 fields
## Geometry type: MULTIPOLYGON
## Dimension:     XY
## Bounding box:  xmin: -78.52874 ymin: 37.22587 xmax: -77.41441 ymax: 38.05642
## CRS:           +proj=longlat +datum=WGS84
## # A tibble: 8 × 3
##   NAME.x                                Perc_StudentsE                  geometry
##   <chr>                                          <dbl>        <MULTIPOLYGON [°]>
## 1 Census Tract 403, Richmond city, Vir…           90.5 (((-77.45652 37.54333, -…
## 2 Census Tract 109.04, Albemarle Count…           86.5 (((-78.52864 38.02705, -…
## 3 Census Tract 6, Charlottesville city…           71.9 (((-78.52363 38.0224, -7…
## 4 Census Tract 402.01, Richmond city, …           68.8 (((-77.45534 37.55372, -…
## 5 Census Tract 109.01, Albemarle Count…           65.9 (((-78.52472 38.0483, -7…
## 6 Census Tract 2.02, Charlottesville c…           60.4 (((-78.50342 38.03681, -…
## 7 Census Tract 1006, Chesterfield Coun…           60.4 (((-77.43459 37.23137, -…
## 8 Census Tract 305.01, Richmond city, …           54.9 (((-77.44895 37.54312, -…

What does the income, and ratio look like there (in counties with the most students)?

Richmond: Median Income is $53,216.5 and the Rent to Tax Ratio is 0.484
Charlottesville: Median Income is $62,477.5 and the Rent to Tax Ratio is 0.433
Henrico: Median Income is $69,827 and the Rent to Tax Ratio is 0.659

How does this compare to the average gini index and who’s below poverty in each county?

Poverty_By_Race %>% 
  group_by(County) %>% 
  summarize(Median_perc_below_poverty = median(Perc_Total_BelowPovertyE, na.rm = TRUE), Median_Gini_Index = median(Gini_IndexE, na.rm = TRUE))

## # A tibble: 11 × 3
##    County          Median_perc_below_poverty Median_Gini_Index
##    <chr>                               <dbl>             <dbl>
##  1 Albemarle                            5.71             0.428
##  2 Charlottesville                     15.3              0.480
##  3 Chesterfield                         5.39             0.356
##  4 Fluvanna                             3.76             0.407
##  5 Greene                               9.22             0.390
##  6 Henrico                              7.54             0.394
##  7 Hopewell                            27.8              0.439
##  8 Louisa                              10.6              0.426
##  9 Nelson                              12.9              0.452
## 10 Petersburg City                     22.1              0.437
## 11 Richmond City                       17.7              0.448

Here’s a closer look at the Gini Index and the percentage of those below the poverty level in each coutny.

Poverty_Stats <- Poverty_By_Race %>% 
  filter(Gini_IndexE >= 0.5 & Perc_Total_BelowPovertyE >= 0.5) %>% 
  select(3,4,36,50) %>% 
  arrange(desc(Gini_IndexE))

knitr::kable(Poverty_Stats)

NAME	County	Gini_IndexE	Perc_Total_BelowPovertyE
Census Tract 201.03, Fluvanna County, Virginia	Fluvanna	0.7173	6.53
Census Tract 403, Richmond city, Virginia	Richmond City	0.7044	66.57
Census Tract 305.01, Richmond city, Virginia	Richmond City	0.6917	58.62
Census Tract 6, Charlottesville city, Virginia	Charlottesville	0.6686	63.91
Census Tract 404, Richmond city, Virginia	Richmond City	0.6400	39.70
Census Tract 207, Richmond city, Virginia	Richmond City	0.6393	21.24
Census Tract 7, Charlottesville city, Virginia	Charlottesville	0.6153	21.08
Census Tract 2008.05, Henrico County, Virginia	Henrico	0.6129	32.49
Census Tract 1009.38, Chesterfield County, Virginia	Chesterfield	0.6044	0.79
Census Tract 9501.02, Nelson County, Virginia	Nelson	0.5953	17.73
Census Tract 2009.08, Henrico County, Virginia	Henrico	0.5929	8.58
Census Tract 405, Richmond city, Virginia	Richmond City	0.5811	14.40
Census Tract 104.01, Albemarle County, Virginia	Albemarle	0.5762	5.29
Census Tract 210, Richmond city, Virginia	Richmond City	0.5745	30.86
Census Tract 204, Richmond city, Virginia	Richmond City	0.5731	50.49
Census Tract 8107, Petersburg city, Virginia	Petersburg City	0.5605	22.63
Census Tract 413, Richmond city, Virginia	Richmond City	0.5551	17.66
Census Tract 2.02, Charlottesville city, Virginia	Charlottesville	0.5448	57.51
Census Tract 109.01, Albemarle County, Virginia	Albemarle	0.5433	29.63
Census Tract 412, Richmond city, Virginia	Richmond City	0.5417	32.50
Census Tract 109.04, Albemarle County, Virginia	Albemarle	0.5407	29.15
Census Tract 4.01, Charlottesville city, Virginia	Charlottesville	0.5317	18.69
Census Tract 209, Richmond city, Virginia	Richmond City	0.5309	8.30
Census Tract 710.04, Richmond city, Virginia	Richmond City	0.5306	50.90
Census Tract 2010.03, Henrico County, Virginia	Henrico	0.5291	18.17
Census Tract 505, Richmond city, Virginia	Richmond City	0.5284	2.57
Census Tract 605.02, Richmond city, Virginia	Richmond City	0.5225	8.58
Census Tract 10, Charlottesville city, Virginia	Charlottesville	0.5205	7.69
Census Tract 101, Albemarle County, Virginia	Albemarle	0.5178	6.29
Census Tract 1009.26, Chesterfield County, Virginia	Chesterfield	0.5125	1.94
Census Tract 501, Richmond city, Virginia	Richmond City	0.5099	8.22
Census Tract 112.01, Albemarle County, Virginia	Albemarle	0.5060	6.02
Census Tract 8106, Petersburg city, Virginia	Petersburg City	0.5018	36.43
Census Tract 102.01, Richmond city, Virginia	Richmond City	0.5017	7.02
Census Tract 8113, Petersburg city, Virginia	Petersburg City	0.5014	34.61
Census Tract 109, Richmond city, Virginia	Richmond City	0.5013	21.20

Which demographics are most likely to be below poverty and above (or at) in each county?

PovertyBy_Race_County <- Poverty_By_Race %>% 
  group_by(County) %>% 
  summarize(Median_Perc_WBelowPoverty = median((Perc_BelowPoverty_WhiteE), na.rm = TRUE), Median_Perc_BBelowPoverty = median((Perc_BelowPoverty_BlackE), na.rm = TRUE), Median_Perc_NativeAm_BelowPoverty = median((Perc_BelowPoverty_NativeAmE), na.rm = TRUE),  Median_Perc_Asian_BelowPoverty = median((Perc_BelowPoverty_AsianE), na.rm = TRUE), Median_Perc_PacificIslander_BelowPoverty = median((Perc_BelowPoverty_PacificIslanderE), na.rm = TRUE), Median_Perc_HispanicLatino_BelowPoverty = median((Perc_BelowPoverty_HispanicLatinoE), na.rm = TRUE))

knitr::kable(PovertyBy_Race_County)

County	Median_Perc_WBelowPoverty	Median_Perc_BBelowPoverty	Median_Perc_NativeAm_BelowPoverty	Median_Perc_Asian_BelowPoverty	Median_Perc_PacificIslander_BelowPoverty	Median_Perc_HispanicLatino_BelowPoverty
Albemarle	5.670	0.840	0.00	0.00	0	0.460
Charlottesville	11.020	14.575	0.00	19.48	0	17.900
Chesterfield	4.140	5.320	0.00	0.00	0	4.420
Fluvanna	3.730	3.690	0.00	0.00	0	0.000
Greene	6.595	9.340	0.00	2.38	NA	8.390
Henrico	5.860	7.080	0.00	0.00	0	0.865
Hopewell	20.820	33.050	0.00	0.00	NA	30.635
Louisa	9.000	20.730	0.00	0.00	NA	0.000
Nelson	4.500	2.750	NA	50.00	NA	0.000
Petersburg City	12.140	23.000	47.22	8.74	0	1.780
Richmond City	9.200	24.690	0.00	26.92	0	12.545

Is there any evidence of residential segragation in Charlottesville and Richmond, Virginia?

Here is a measure of the Exposure, via the Isolation Index of Black groups

#
 HDSpatial_Updated <- HousingDataSpatial %>%
   mutate(county_tract = paste(COUNTYFP,TRACTCE, sep = "")) 
#
 cvl_rva_measures_Spatial <- full_join(cvl_rva_measures, HDSpatial_Updated, by = "county_tract") %>%
   sf::st_as_sf() |>
   sf::st_transform(crs = 4326)
#
pal3 <-  colorNumeric("viridis", cvl_rva_measures_Spatial$iso_b_block, reverse = TRUE)

cvl_rva_measures_Spatial %>%
 leaflet() %>%
   addTiles() %>%
   addPolygons(color = "black",
               fillColor = ~pal3(iso_b_block),
               fillOpacity = 0.6,
               weight = 2,
               highlight = highlightOptions(
                 weight = 3,
                 fillOpacity = 0.9,
                 bringToFront = T),
               popup = paste0("County: ", cvl_rva_measures_Spatial$County, "<br>",
                              "Tract: ", cvl_rva_measures_Spatial$NAME.x, "<br>",
                              "Isolation Index: ", cvl_rva_measures_Spatial$iso_b_block)) %>%
  addLegend(pal = pal3,
             values = ~iso_b_block,
             opacity = 0.7,
            title = "Black Isolation Index (2020)",
             position = "bottomleft")

Here is a measure of Evenness, via the Dissimilarity Index between White and Black Groups

pal4 <-  colorNumeric("viridis", cvl_rva_measures_Spatial$dissim_wb_block, reverse = TRUE)

cvl_rva_measures_Spatial %>%
 leaflet() %>%
   addTiles() %>%
   addPolygons(color = "black",
               fillColor = ~pal4(dissim_wb_block),
               fillOpacity = 0.6,
               weight = 2,
               highlight = highlightOptions(
                 weight = 3,
                 fillOpacity = 0.9,
                 bringToFront = T),
               popup = paste0("County: ", cvl_rva_measures_Spatial$County, "<br>",
                              "Tract: ", cvl_rva_measures_Spatial$NAME.x, "<br>",
                              "Dissimilarity Index: ", cvl_rva_measures_Spatial$dissim_wb_block)) %>%
  addLegend(pal = pal4,
             values = ~dissim_wb_block,
             opacity = 0.7,
            title = "Whtie and Black Dissimilarity Index (2020)",
             position = "bottomleft")

Relationships (Linear Models)

The relationship between demographics of renters and rent expoitation

Tenure_and_Housing_Data  %>% 
  filter(Tenure_Type == "Renter" & Race %in% race) %>% 
  ggplot(aes(x = `Percentage (Estimated)`, y = RentTaxRatio, color = Region.y)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") + 
  facet_wrap(~Race) + 
  labs(title = "Demographic of Renter vs Rent Exploitation in Charlottesville and Richmond, VA", x = "Percentage of Renter (Estimated)", y = "Rent to Tax Ratio", color = "Region")

#Below is the Linear Model Coefficient


lm1 <- lm(RentTaxRatio ~ `Percentage (Estimated)`:factor(Race), data = Tenure_and_Housing_Data)
lm1

## 
## Call:
## lm(formula = RentTaxRatio ~ `Percentage (Estimated)`:factor(Race), 
##     data = Tenure_and_Housing_Data)
## 
## Coefficients:
##                                             (Intercept)  
##                                                  0.6365  
##              `Percentage (Estimated)`:factor(Race)Asian  
##                                                 -0.2752  
##              `Percentage (Estimated)`:factor(Race)Black  
##                                                  0.1288  
## `Percentage (Estimated)`:factor(Race)Hispanic or Latino  
##                                                  0.5291  
##    `Percentage (Estimated)`:factor(Race)Native American  
##                                                 -0.2271  
##   `Percentage (Estimated)`:factor(Race)Pacific Islander  
##                                                  2.1519  
##              `Percentage (Estimated)`:factor(Race)White  
##                                                 -0.0360

The relationship between demographics of renters and being rent burndened

#Graph

Tenure_and_Housing_Data  %>% 
  filter(Tenure_Type == "Renter" & Race %in% race) %>% 
  ggplot(aes(x = `Percentage (Estimated)`, y = PercRentBurdenE, color = Region.y)) +
  scale_color_viridis_d() +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") + 
  facet_wrap(~Race) +
  labs(title = "Demographic of Renter vs Rent Burden in CVL and RVA", x = "Percentage of Renter (Estimated)", y = "Rent as a Percentage of Income", color = "Region")

#Below is the Linear Model Coefficient


lm3 <- lm(PercRentBurdenE ~ Race:`Percentage (Estimated)`, data = Tenure_and_Housing_Data)
lm3

## 
## Call:
## lm(formula = PercRentBurdenE ~ Race:`Percentage (Estimated)`, 
##     data = Tenure_and_Housing_Data)
## 
## Coefficients:
##                                     (Intercept)  
##                                          30.431  
##              RaceAsian:`Percentage (Estimated)`  
##                                          -3.197  
##              RaceBlack:`Percentage (Estimated)`  
##                                           3.336  
## RaceHispanic or Latino:`Percentage (Estimated)`  
##                                           4.721  
##    RaceNative American:`Percentage (Estimated)`  
##                                          44.182  
##   RacePacific Islander:`Percentage (Estimated)`  
##                                         -46.827  
##              RaceWhite:`Percentage (Estimated)`  
##                                          -1.090

The relationship between those who are rent burdened and rent tax ratio

Tenure_and_Housing_Data %>% 
ggplot(aes(x = PercRentBurdenE, y = RentTaxRatio)) + 
  geom_point(alpha = 0.3) +
    geom_smooth(method = "lm") +
  facet_wrap(~Region.y)

#Below is the Linear Model Coefficient

lm5 <- lm(RentTaxRatio ~ PercRentBurdenE:Region.y, data = Tenure_and_Housing_Data)
lm5

## 
## Call:
## lm(formula = RentTaxRatio ~ PercRentBurdenE:Region.y, data = Tenure_and_Housing_Data)
## 
## Coefficients:
##                             (Intercept)  
##                               5.740e-01  
## PercRentBurdenE:Region.yCharlottesville  
##                              -3.710e-06  
##        PercRentBurdenE:Region.yRichmond  
##                               2.836e-03

The relationship between the those below the poverty level and the Gini index

Poverty_By_Race %>% 
  ggplot(aes(x = Perc_Total_BelowPovertyE, y = Gini_IndexE)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") +
  facet_wrap(~Region)

#Below is the Linear Model formula 

lm(Gini_IndexE ~ Perc_Total_BelowPovertyE:Region, data = Poverty_By_Race)

## 
## Call:
## lm(formula = Gini_IndexE ~ Perc_Total_BelowPovertyE:Region, data = Poverty_By_Race)
## 
## Coefficients:
##                                    (Intercept)  
##                                        0.38046  
## Perc_Total_BelowPovertyE:RegionCharlottesville  
##                                        0.00451  
##        Perc_Total_BelowPovertyE:RegionRichmond  
##                                        0.00250

The relationshiop between Rent exploitation and segregation meausres

#The Dissimilarity Index (Between White and Black)

cvl_rva_measures_Spatial %>% 
  ggplot(aes(x = dissim_wb_block, y = RentTaxRatio)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") +
  facet_wrap(~Region)

lm(RentTaxRatio ~ dissim_wb_block:Region, data = cvl_rva_measures_Spatial) #-0.4407

## 
## Call:
## lm(formula = RentTaxRatio ~ dissim_wb_block:Region, data = cvl_rva_measures_Spatial)
## 
## Coefficients:
##                           (Intercept)  dissim_wb_block:RegionCharlottesville  
##                                0.8106                                -0.5066  
##        dissim_wb_block:RegionRichmond  
##                               -0.3735

#The (Black) Isolation Index

cvl_rva_measures_Spatial %>% 
  ggplot(aes(x = iso_b_block, y = RentTaxRatio)) +
  geom_point(alpha = 0.3) +
  geom_smooth(method = "lm") +
  facet_wrap(~Region)

lm(RentTaxRatio ~ iso_b_block:Region, data = cvl_rva_measures_Spatial) #0.3226

## 
## Call:
## lm(formula = RentTaxRatio ~ iso_b_block:Region, data = cvl_rva_measures_Spatial)
## 
## Coefficients:
##                       (Intercept)  iso_b_block:RegionCharlottesville  
##                            0.5246                             0.2395  
##        iso_b_block:RegionRichmond  
##                            0.3164

Housing Justice - Rent Exploitation

Sokona Mangane

2022-07-06